home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / libraries / dylan / semaphore.dylan < prev    next >
Encoding:
Text File  |  1995-03-15  |  2.6 KB  |  79 lines  |  [TEXT/ttxt]
  1. module: threads
  2. rcs-header: $Header: semaphore.dylan,v 1.3 94/06/27 17:10:32 wlott Exp $
  3.  
  4. //======================================================================
  5. //
  6. // Copyright (c) 1994  Carnegie Mellon University
  7. // All rights reserved.
  8. // 
  9. // Use and copying of this software and preparation of derivative
  10. // works based on this software are permitted, including commercial
  11. // use, provided that the following conditions are observed:
  12. // 
  13. // 1. This copyright notice must be retained in full on any copies
  14. //    and on appropriate parts of any derivative works.
  15. // 2. Documentation (paper or online) accompanying any system that
  16. //    incorporates this software, or any part of it, must acknowledge
  17. //    the contribution of the Gwydion Project at Carnegie Mellon
  18. //    University.
  19. // 
  20. // This software is made available "as is".  Neither the authors nor
  21. // Carnegie Mellon University make any warranty about the software,
  22. // its performance, or its conformity to any specification.
  23. // 
  24. // Bug reports, questions, comments, and suggestions should be sent by
  25. // E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  26. //
  27. //======================================================================
  28. //
  29. // This file contains binary semaphores.
  30. //
  31.  
  32. define class <semaphore> (<lock>)
  33.  
  34.   // The spinlock we use to make sure operations on the semaphore are atomic.
  35.   slot lock :: <spinlock>, setter: #f,
  36.     init-function: curry(make, <spinlock>);
  37.  
  38.   // True if locked, false if not.  (surprise!)
  39.   slot locked? :: <boolean>, init-value: #f;
  40.  
  41.   // The event we use to signal when the semaphore becomes available.
  42.   slot available :: <event>, setter: #f,
  43.     init-function: curry(make, <event>);
  44. end;
  45.  
  46. define method grab-lock (semaphore :: <semaphore>)
  47.   grab-lock(semaphore.lock);
  48.   while (locked?(semaphore))
  49.     wait-for-event(semaphore.available, semaphore.lock);
  50.     grab-lock(semaphore.lock);
  51.   end;
  52.   semaphore.locked? := #t;
  53.   release-lock(semaphore.lock);
  54. end;
  55.  
  56. define method release-lock (semaphore :: <semaphore>)
  57.   grab-lock(semaphore.lock);
  58.   if (semaphore.locked?)
  59.     semaphore.locked? := #f;
  60.     signal-event(semaphore.available);
  61.     release-lock(semaphore.lock);
  62.   else
  63.     release-lock(semaphore.lock);
  64.     error("%= isn't locked, hence cannot be unlocked");
  65.   end;
  66. end;
  67.  
  68. define method wait-for-event (event :: <event>, semaphore :: <semaphore>)
  69.   grab-lock(semaphore.lock);
  70.   if (semaphore.locked?)
  71.     semaphore.locked? := #f;
  72.     signal-event(semaphore.available);
  73.     wait-for-event(event, semaphore.lock);
  74.   else
  75.     release-lock(semaphore.lock);
  76.     error("%= isn't locked, hence cannot be unlocked");
  77.   end;
  78. end;
  79.